home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1995 October / EnigmA AMIGA RUN 01 (1995)(G.R. Edizioni)(IT)[!][issue 1995-10][Aminet 7].iso / Aminet / comm / fido / FQUERY.lha / rexx / FQscan.rexx
OS/2 REXX Batch file  |  1995-04-11  |  9KB  |  295 lines
  1. /**/
  2. v="$VER: FQscan Rexx  Packet Scanner for FQUERY Williamson 55.67"
  3. if ~show('L',"rexxsupport.library") then
  4.   if ~addlib("rexxsupport.library",0,-30,0) then do
  5.     say "Couldn't access support.library !"
  6.     EXIT 20
  7.   end
  8. if arg()=0 then do
  9.   say;Say subword(v,4);say
  10.   say ' usage:  FQscan [cfgfile] list of packets'
  11.   say ' eg:  FQscan cfg:FQ.cfg mail:audit/35656187.pkt mail:inbound/12567736.pkt' 
  12.   say ' The cfgfile can be omitted if it is in the assigned volume CFG:'
  13.   say ' eg:    FQscan mail:audit/35656187.pkt mail:inbound/12567736.pkt'  
  14.   say ' or'
  15.   say '         FQscan SHOW'
  16.   say '                Displays configuration'
  17.   say 
  18.   exit
  19. end
  20. log=show('p','ROOFLOG')
  21. PROGLIST="FILEFIND ALLFIX FQUERY FILEQUERY"
  22. parse arg args
  23. if pos("FQ.CFG",upper(ARGS))>0 then do
  24.   parse var args cfg files
  25.   cfg=strip(cfg)
  26. end;else do
  27.   files=args
  28.   cfg="CFG:FQ.CFG"
  29. end
  30. files=strip(files)
  31. if ~open('cfg',cfg,'r') then do
  32.   Say 'Cannot find 'cfg
  33.   exit 10
  34. end
  35. SOH=d2c(1);CR='0D'x;LF='0A'x
  36. TRUE=1;FALSE=0
  37. maxbuf=(1024*32);lbuf=""
  38. fqm=0;fqt=0;findlist=""
  39. do while ~eof('cfg')
  40.   q=upper(readln('cfg'))
  41.   if q="" | left(q,1)=" " then iterate
  42.   parse var q vname vval
  43.   vname=upper(vname)
  44.   select 
  45.     when vname="NONETSCAN" then nonetscan=strip(vval)==TRUE
  46.     when vname="SITELIST" then sitelist=dequote(vval)
  47.     when vname="MSGLIST" then msglist=dequote(vval)
  48.     when vname="FTNLIST" then ftnlist=dequote(vval)
  49.     when vname="FQLOG" then FQLOG=dequote(vval)
  50.     when vname="LOGLEVEL" then LOGLEVEL=strip(vval)
  51.     when left(vname,7)="FQECHO." then FINDLIST=FINDLIST||upper(strip(dequote(vval)))" "
  52.     otherwise nop
  53.   end
  54. end
  55. call close('cfg')
  56. if ~NONETSCAN then FINDLIST="NETMAIL "||strip(FINDLIST)  
  57. if pos("SHOW",upper(args))>0  then do
  58.   bol.0="FALSE";bol.1="TRUE"
  59.   say;Say subword(v,4);say
  60.   say "   NoNetScan  :"bol.NONETSCAN  
  61.   say "   SiteList   :"SITELIST
  62.   say "   FindList   :"FINDLIST
  63.   say "   MsgList    :"MSGLIST
  64.   say "   FQlog      :"FQLOG
  65.   say "   LogLevel   :"LOGLEVEL
  66.   say "   FTNlist    :"FTNLIST
  67.   exit
  68. end
  69.  
  70. do while words(files)>0
  71.   parse var files packet " " files
  72.   if ~open('pkt',packet,'R') then do
  73.     call writelog("Cannot open "packet,0)
  74.     iterate
  75.   end;else do
  76.     fqm=0
  77.     pktlen=subword(statef(packet),2,1)
  78.     call writelog("Packet:" packet "Size:"pktlen,4)
  79.     if pktlen<(1024*63) then do
  80.       pbufed=0
  81.       pbuf=readch('pkt',pktlen) 
  82.       call close('pkt')
  83.       buflen=pktlen
  84.       validsite=scanhdr()
  85.       if ~validsite then Iterate
  86.       offset=58
  87.     end;else do
  88.       pbufed=1
  89.       pbuf=readch('pkt',58)
  90.       validsite=scanhdr() 
  91.       if ~validsite then do
  92.         call close('pkt')
  93.         Iterate
  94.       end
  95.       call loadbuf()
  96.     end
  97.  
  98.     msgs=0
  99.     do forever
  100.       if offset>=buflen then do
  101.         if ~loadbuf() then leave
  102.       end
  103.       z=getint(offset)
  104.       if z~=2 then do
  105.         call writelog(c2x(z) 'Not 0200 at offset:'offset,9)
  106.         if offset=buflen then leave          
  107.         offset=offset+2 
  108.         call writelog('Bumped offset:'offset,9)
  109.       end 
  110.       tagname="NETMAIL";intl="";msgid="";fmpt="";morg="";msgs=msgs+1
  111.       call writech(STDOUT,CR'Msg:'msgs' ')
  112.       pfrom=getint(offset+6)"/"getint(offset+2)
  113.       pto=getint(offset+8)"/"getint(offset+4)
  114.       flags=getword(offset+10)
  115.       cost=getint(offset+12)
  116.       offset=offset+14 /* 34 */
  117.       msgdate=getstring()  
  118.       toname=upper(getstring())
  119.       fromname=getstring()
  120.       subject=getstring()
  121.       text=getstring()
  122.       if text="" then leave
  123.       if left(text,5)="AREA:" then tagname=substr(text,6,pos('0D'x,text,6)-6)
  124.  
  125.       if pos(word(toname,1)||" ",proglist)>0 & pos(tagname,findlist)>0 then do   
  126.  
  127.         z=pos(SOH"INTL",text)
  128.         if z>0 then do
  129.           mpos=z+5
  130.           intl=word(strip(strip(substr(text,mpos,pos('0D'x,text,mpos+1)-mpos)),'L',':'),1)
  131.         end 
  132.         z=pos(SOH"MSGID: ",text)
  133.         if z>0 then do
  134.           mpos=z+8
  135.           Msgid=substr(text,mpos,pos('0D'x,text,mpos+1)-mpos)
  136.         end 
  137.         z=pos(SOH"FMPT",text)
  138.         if z>0 then do
  139.           mpos=z+5
  140.           fmpt=strip(strip(substr(text,mpos,pos('0D'x,text,mpos+1)-mpos)),'L',':')
  141.         end 
  142.         z=pos(" * Origin: ",text)
  143.         if z>0 then do
  144.           moxxy=substr(text,z,pos('0D'x,text,z+1)-z)
  145.           ox=lastpos(')',MOXXY)
  146.           oy=lastpos('(',MOXXY,ox-1)
  147.           morg=substr(MOXXY,oy+1,(ox-1)-oy)
  148.         end
  149.         if loglevel>8 then do
  150.           call writelog("Area:    " tagname) 
  151.           call writelog("From:    " fromname)
  152.           call writelog("To:      " toname)
  153.           call writelog("Subj:    " subject)
  154.           call writelog("Date:    " msgdate)
  155.           call writelog("Origin:  " morg)
  156.           call writelog("Intl:    " intl)
  157.           call writelog("Msgid:   " msgid)
  158.           call writelog("Fmpt:    " fmpt)
  159.           say
  160.         end
  161.         if morg="" & intl~="" then morg=intl
  162.         if tagnme="NETMAIL" & NONETSCAN then iterate
  163.         lbuf=lbuf||tagname'|'toname'|'fromname'|'subject'|'msgdate'|'morg'|'msgid'|'fmpt||LF
  164.         fqm=fqm+1
  165.       end     
  166.     end
  167.   end
  168.   if pbufed then call close('pkt')
  169.   call writelog('Found 'fqm' queries in 'packet' from 'fromsite,1)
  170.   fqt=fqt+fqm
  171. end 
  172. if lbuf~="" then do
  173.   if ~open('l',msglist,'a') then do
  174.     if ~open('l',msglist,'w') then do
  175.       call writelog('Cannot open 'msglist,0)
  176.       exit 20
  177.     end
  178.   end
  179.   call writech('l',lbuf)
  180.   call close('l')
  181. end
  182. if words(files)>0 then call writelog('Found 'fqt' total queries',1)
  183. exit
  184.  
  185.  
  186. scanhdr:
  187.   if getint(18) ~=2 then do
  188.     call writelog("Packet type" getint(18)", can't process this type",0)
  189.     return 0
  190.   end;else do
  191.     product=getbyte(24)
  192.     ozone=getint(46);if ozone=0 | ozone=256 then ozone=getint(34)
  193.     dzone=Getint(48);if dzone=0 | dzone=256 then dzone=getint(36)
  194.  
  195.     if ozone=0 | ozone=256 | dzone=0 | dzone=256 then do
  196.       call writelog("ERR: Can't find ftn, zone undefined",0)
  197.       return 0
  198.     end
  199.     oftn=find_ftn(ozone)
  200.     dftn=find_ftn(dzone)
  201.     fromsite=oftn"#"ozone":"getint(20)"/"getint(0)"."getint(50)
  202.     call writelog("From:" fromsite,3)
  203.     call writelog("To:" dftn"#"dzone":"getint(22)"/"getint(2)"."getint(52),3)
  204.     call writelog("Date:"getint2(8)"."getint2(6)"."getint(4)"  "getint2(10)":"getint2(12)":"getint2(14),3)
  205.     z=getint(16)
  206.     if pos(upper(fromsite),sitelist)=0 then do
  207.       call writelog(packet' from 'fromsite', not valid feed',0)
  208.       return 0
  209.     end
  210.   end
  211. return 1
  212.  
  213. getword: return reverse(substr(pbuf,arg(1)+1,2))
  214. getint:  return c2d('00'x||reverse(substr(pbuf,arg(1)+1,2)))
  215. getint2: return right('00'||c2d('00'x||reverse(substr(pbuf,arg(1)+1,2))),2)
  216. getbyte: return c2d('00'x||substr(pbuf,arg(1)+1,1))
  217.  
  218. getstring:
  219.   if offset>buflen then return ""
  220.   actpos=offset+1
  221.   offset=Pos('00'x,pbuf,actpos)
  222.   if offset=0 then do
  223.     call writelog('Error: cannot find NULL @ offset'actpos offset '=' c2x(substr(pbuf,actpos-1)),1)
  224.     offset=buflen
  225.   end
  226. return substr(pbuf,actpos,offset-actpos)
  227.  
  228. loadbuf:
  229. call writelog("LoadBuf FilePos:"seek('pkt',0,'C'),9)
  230. pbuf=readch('pkt',maxbuf)
  231. buflen=length(pbuf)
  232. if buflen=0 then return 0
  233.  
  234. call writelog('This pbuf Start:'c2x(left(pbuf,16)),9)  
  235. call writelog('This pbuf End:'  c2x(right(pbuf,16)),9)
  236.  
  237. if c2x(right(pbuf,3))='000000' then do
  238.   call writelog('07'x 'Last pbuf Length:'buflen,9)
  239.   offset=0
  240.   return 1
  241. end
  242.  
  243. if loglevel>8 then do
  244.   call writelog('This pbuf Length:' buflen,9)  
  245.   call writelog("LoadBuf FilePos:"seek('pkt',0,'C'),9)
  246. end
  247. LastMsgPos=lastpos('000200'x,pbuf)
  248. LastMsgStart=LastMsgPos+1
  249. if loglevel>8 then do
  250.   call writelog('Next:'c2x(substr(pbuf,LastMsgStart,16)))  
  251.   call writelog('Read:'buflen' LastMsg:'LastMsgStart '+58(header)='LastMsgStart+58)
  252.   call writelog('Size:'buflen-(buflen-(LastMsgStart)))
  253. end
  254. seek_off=(LastMsgStart-buflen)-1
  255. newpos=seek('pkt',seek_off,'C') 
  256.  
  257. pbuf=delstr(pbuf,LastMsgStart)
  258. buflen=length(pbuf)
  259.  
  260. if loglevel>8 then do
  261.   call writelog('Seek Offset:'seek_off'  Respositioned:'newpos)
  262.   call writelog('New End:'  c2x(right(pbuf,16)))
  263.   call writelog('New Length:'buflen)
  264. end
  265. offset=0
  266. return 1
  267.  
  268.  
  269. find_ftn: procedure expose ftnlist
  270. if pos(arg(1),"1 2 3 4 5 6")>0  then return "FIDONET"
  271. if pos(arg(1),"39 40 41")>0 then return "AMIGANET"
  272. dz=FIND(ftnlist,arg(1))
  273. if dz=0 then return 0
  274. else return strip(word(ftnlist,dz-1))
  275.  
  276.  /* a useful procedure by Walt Sullivan    */
  277. dequote: 
  278.   parse arg thing
  279.   parse var thing '"' unq_thing '"'
  280.   if unq_thing~="" then return unq_thing
  281. return thing
  282.  
  283. WriteLog: procedure expose log FQlog loglevel
  284. if arg(2)>loglevel then return 0  
  285. call writeln(STDOUT,arg(1))
  286. if ~open('tl',FQLOG,'A') then do
  287.   if ~open('tl',FQLOG,'W') then do
  288.     Say 'Cannot open 'FQLOG
  289.     return 0
  290.   end
  291. end
  292. call writeln('tl',time() arg(1));call close('tl')
  293. if log then address "ROOFLOG" 'LOGLINE 'left(time(),5) 'FQuery: 'arg(1)
  294. return 0
  295.